--- Generate roman numerals
module frege.compiler.common.Roman where

import Data.Tuples public() 

private !alphabet = [
    (1_000_000_000, 'T', 100_000_000, 'R'),
    (  500_000_000, 'S', 100_000_000, 'R'),
    (100_000_000, 'R', 10_000_000, 'O'),
    ( 50_000_000, 'P', 10_000_000, 'O'),
    (10_000_000, 'O', 1_000_000, 'K'),
    ( 5_000_000, 'N', 1_000_000, 'K'),
    (1000000, 'K', 100000, 'H'),
    ( 500000, 'J', 100000, 'H'),
    (100000, 'H', 10000, 'F'),
    ( 50000, 'G', 10000, 'F'),
    (10000, 'F', 1000, 'M'),
    ( 5000, 'E', 1000, 'M'), 
    (1000, 'M', 100, 'C'),
    ( 500, 'D', 100, 'C'),
    ( 100, 'C',  10, 'X'),
    (  50, 'L',  10, 'X'),
    (  10, 'X',   1, 'I'),
    (   5, 'V',   1, 'I'),
    (   1, 'I',   0, 'Z')
    ]

!romNums = arrayCache (\n arr -> packed (romanNumber n)) 100
romanUpper x
    | x >= 0, x < 100 = romNums `elemAt` x
    | otherwise       = packed (romanNumber x)

romanLower x = (romanUpper x).toLowerCase

romanNumber n 
    | n == minBound = '-' : 'T' : rom alphabet (abs (n + 1_000_000_000))
    | n < 0     = '-' : rom alphabet (abs n)
    | n == 0    = ['Z']
    | n == 1    = ['U' ]
    | n == 2    = ['B' ]
    | n == 3    = ['T' ]
    | n == 4    = ['Q' ]
    | otherwise = rom alphabet n
    where
        rom :: [(Int, Char, Int, Char)] -> Int -> [Char]
        rom (alpha@(u, uc, d, dc):xs) n
            | n >= u = uc : rom alpha (n-u)
            | n >= (u-d) = dc : uc : rom xs (n-u+d)
            | otherwise  = rom xs n
        rom [] 0 = []
        rom xx y = error ("rom " ++ show xx ++ " " ++ show y) 

